home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / perl5.005.tar.gz / perl5.005.tar / perl5.005 / vms / ext / vmsish.pm < prev    next >
Text File  |  1998-07-19  |  2KB  |  77 lines
  1. package vmsish;
  2.  
  3. =head1 NAME
  4.  
  5. vmsish - Perl pragma to control VMS-specific language features
  6.  
  7. =head1 SYNOPSIS
  8.  
  9.     use vmsish;
  10.  
  11.     use vmsish 'status';    # or '$?'
  12.     use vmsish 'exit';
  13.     use vmsish 'time';
  14.  
  15.     use vmsish;
  16.     no vmsish 'time';
  17.  
  18. =head1 DESCRIPTION
  19.  
  20. If no import list is supplied, all possible VMS-specific features are
  21. assumed.  Currently, there are three VMS-specific features available:
  22. 'status' (a.k.a '$?'), 'exit', and 'time'.
  23.  
  24. =over 6
  25.  
  26. =item C<vmsish status>
  27.  
  28. This makes C<$?> and C<system> return the native VMS exit status
  29. instead of emulating the POSIX exit status.
  30.  
  31. =item C<vmsish exit>
  32.  
  33. This makes C<exit 1> produce a successful exit (with status SS$_NORMAL),
  34. instead of emulating UNIX exit(), which considers C<exit 1> to indicate
  35. an error.  As with the CRTL's exit() function, C<exit 0> is also mapped
  36. to an exit status of SS$_NORMAL, and any other argument to exit() is
  37. used directly as Perl's exit status.
  38.  
  39. =item C<vmsish time>
  40.  
  41. This makes all times relative to the local time zone, instead of the
  42. default of Universal Time (a.k.a Greenwich Mean Time, or GMT).
  43.  
  44. =back
  45.  
  46. See L<perlmod/Pragmatic Modules>.
  47.  
  48. =cut
  49.  
  50. if ($^O ne 'VMS') {
  51.     require Carp;
  52.     Carp::croak("This isn't VMS");
  53. }
  54.  
  55. sub bits {
  56.     my $bits = 0;
  57.     my $sememe;
  58.     foreach $sememe (@_) {
  59.     $bits |= 0x01000000, next if $sememe eq 'status' || $sememe eq '$?';
  60.     $bits |= 0x02000000, next if $sememe eq 'exit';
  61.     $bits |= 0x04000000, next if $sememe eq 'time';
  62.     }
  63.     $bits;
  64. }
  65.  
  66. sub import {
  67.     shift;
  68.     $^H |= bits(@_ ? @_ : qw(status exit time));
  69. }
  70.  
  71. sub unimport {
  72.     shift;
  73.     $^H &= ~ bits(@_ ? @_ : qw(status exit time));
  74. }
  75.  
  76. 1;
  77.